(*  :Title:	Heuristic Application of Rules  *)

(*  :Authors:	Brian Evans, James McClellan  *)

(*
    :Summary:	To provide heuristics for the intelligent application
		of rules involved in one-to-many transformation a la
		Covell.
 *)

(*  :Context:	SignalProcessing`ObjectOriented`RewriteRules`  *)

(*  :PackageVersion:  2.7	*)

(*
    :Copyright:	Copyright 1989-1991 by Brian L. Evans
		Georgia Tech Research Corporation

	Permission to use, copy, modify, and distribute this software
	and its documentation for any purpose and without fee is
	hereby granted, provided that the above copyright notice
	appear in all copies and that both that copyright notice and
	this permission notice appear in supporting documentation,
	and that the name of the Georgia Tech Research Corporation,
	Georgia Tech, or Georgia Institute of Technology not be used
	in advertising or publicity pertaining to distribution of the
	software without specific, written prior permission.  Georgia
	Tech makes no representations about the suitability of this
	software for any purpose.  It is provided "as is" without
	express or implied warranty.
 *)

(*  :History:	*)

(*  :Keywords:	*)

(*
    :Source:	M. M. Covell.  {An Algorithm Design Environment for
		  Signal Processing}.  M.I.T. Ph. D. Thesis.  December,
		  1989.

		C. S. Myers.  {Signal Representation for Symbolic and
		  Numeric Processing}.  M.I.T. Ph. D. Thesis.  August,
		  1986.  Appendix D.
 *)

(*  :Warning:	*)

(*  :Mathematica Version:  1.2 or 2.0  *)

(*  :Limitation:  *)

(*
    :Discussion:  The blind application of a set of rewrite rules to
		  an entire expression will cause a combinatoric
		  explosion of equivalent forms.  Therefore, it is
		  desirable to apply them in an intelligent or
		  heuristic manner.
 *)

(*  :Functions:	 *)



(*  B E G I N     P A C K A G E  *)


BeginPackage[ "SignalProcessing`ObjectOriented`Heuristic`",
	      "SignalProcessing`Support`Tree`",
	      "SignalProcessing`Support`SupCode`" ]


If [ TrueQ[ $VersionNumber >= 2.0 ],
     Off[ General::spell ];
     Off[ General::spell1 ] ];


(*  U S A G E     I N F O R M A T I O N  *)

SPHeuristicRewrite::usage =
	"SPHeuristicRewrite[expr, rules] tries to rewrite expressions \
	on the same level of expr together using the list of rules."

SPRecursiveRewrite::usage =
	"SPRecursiveRewrite[expr, rules] only returns a fully rewritten \
	version of the signal processing expression expr. \
	The Rewrite knowledge base is let loose on the expression expr \
	without any guidance. \
	The user can see the intermediate expressions by setting the \
	Dialogue option to True or False."

(*  E N D     U S A G E     I N F O R M A T I O N  *)


Begin[ "`Private`" ]


(*  B L I N D L Y     A P P L Y I N G     R E W R I T E     R U L E S  *)

(*  The Rewrite rules base can be driven by several routines.  *)

(*  Recursive Rewrite rules or when all else fails	*)
(*	op_[p__][args__] :> op[p] [ f[args] ] ,		*)
(*	op_[p__] :> op[p] ,				*)

SPRecursiveRewrite::badrec =
	"The MaxRecursion option is not set to a positive integer"

Options[ SPRecursiveRewrite ] :=
	{ Dialogue -> False, MaxRecursion -> $RecursionLimit }

SPRecursiveRewrite[e_, rules_, options___] :=
	Block [	{dialogue, difference = True, iteration = 0, maxiterations,
		 newexpr, oldexpr, oplist},
		oplist = ToList[options] ~Join~ Options[SPRecursiveRewrite];
		dialogue = InformUserQ[ oplist ];
		maxiterations = Replace[ MaxRecursion, oplist];
		If [ ! ( IntegerQ[maxiterations] && maxiterations > 0 ),
		     maxiterations = $RecursionLimit;
		     Message[ SPRecursiveRewrite::badrec, maxiterations ] ];

		newexpr = e;
		If [ dialogue, Print[e] ];
		While [ difference && iteration < maxiterations,
			iteration++;
			oldexpr = newexpr;
			newexpr = Replace[oldexpr, rules];
			difference = ! SameQ[oldexpr, newexpr];
			If [ difference && dialogue,
			     Print["which becomes"]; Print[newexpr] ] ];

		newexpr ]


(*  I N T E L L I G E N T  L Y     A P P L Y I N G     R U L E S  *)

SPRecursiveRewrite::badrec =
"The MaxRecursion option is not set to a positive integer--- `` will be used."

Options[ SPHeuristicRewrite ] :=
	{ Dialogue -> False, MaxRecursion -> $RecursionLimit }

SPHeuristicRewrite[expr_, rules_, options___] :=
	Block [	{dialogue, difference = True, iteration = 0, maxiterations,
		 newexpr, oldexpr, oplist},
		oplist = ToList[options] ~Join~ Options[SPHeuristicRewrite];
		dialogue = InformUserQ[ oplist ];
		maxiterations = Replace[ MaxRecursion, oplist ];
		If [ ! ( IntegerQ[maxiterations] && maxiterations > 0 ),
		     maxiterations = $RecursionLimit;
		     Message[ SPRecursiveRewrite::badrec, maxiterations ] ];

		RuleList = rules;		(* global to package *)
		heuristicrewrite[ expr, maxiterations,
				  dialogue, 0, Depth[expr] ] ]

heuristicrewrite[expr_, maxi_, dialogue_, level_, stoplevel_] :=
	expr /;
	AtomQ[expr] || ( maxi <= 0 ) || SameQ[level, stoplevel]

heuristicrewrite[expr_, maxi_, dialogue_, level_, stoplevel_] :=
	heuristicrewrite[expr, maxi, dialogue, 0, stoplevel] /;
	level >= Depth[expr]

heuristicrewrite[expr_, maxi_, dialogue_, level_, stoplevel_] :=
	Block [	{applyflag, curnode, currule, funp, newlist = {}, nextlevel,
		 node, nodelist, norulesapplied, numnodes, numrules, rule},

		nextlevel = level + 1;

		(* For each rule,					*)
		(*   If the rule applies to all of the children of at	*)
		(*      least one node at level level			*)
		(*   Then apply the rule to the children of every node	*)
		(*        if the rule applies to all of the children	*)
		(*        add the new expression to newlist		*)

		nodelist = Level[expr, {level}];
		numnodes = Length[nodelist];
		numrules = Length[RuleList];
		For [ rule = 1, rule <= numrules, rule++,
		      currule = RuleList[[rule]];
		      applyflag = False;
		      For [ node = 1, node <= numnodes, node++,
			    curnode = nodelist[[node]];
			    If [ RuleAppliesQ[curnode, currule, True],
				 applyflag = True; Break[] ] ];
		      If [ applyflag,
			   AppendTo[ newlist,
				     Map[ applytochildren[#, currule]&,
					  expr,
					  {level} ] ] ] ];

		(* If no rules were applied to level level of expr,	*)
		(* Then try the next level of the expression		*)
		(* Else try the next level of each new expression	*)

		norulesapplied = EmptyQ[newlist];
		If [ norulesapplied,
		     heuristicrewrite[ expr, maxi - 1,
				       dialogue, nextlevel, stoplevel ],

		     funp = heuristicrewrite[ #, maxi - 1, dialogue,
		     			      nextlevel, level ]&;
		     Prepend[Map[funp, newlist], expr] ] ]


applytochildren[ node_, rule_ ] := node /; AtomQ[node]
applytochildren[ h_[e1_, rest___], rule_ ] :=
	Apply[ h, Map[ Replace[#, rule]&, {e1, rest} ] ] /;
	RuleAppliesQ[ h[e1, rest], rule, True ]
applytochildren[ node_, rule_ ] := node 


(*  E N D     P A C K A G E  *)

End[]
EndPackage[]

If [ TrueQ[ $VersionNumber >= 2.0 ],
     On[ General::spell ];
     On[ General::spell1 ] ];


(*  W R I T E     P R O T E C T I O N  *)

Block [	{newfuns},
	newfuns = { SPHeuristicRewrite, SPRecursiveRewrite };
	Combine[ SPfunctions, newfuns ];
	Apply[ Protect, newfuns ] ]


(*  E N D I N G     M E S S A G E  *)

Print["System rewrite rules have been loaded."]
Null
